bayer/analysis_DK/stopping rules test_DK.R

In 0liver0815/onc-crmpack-test: Object-Oriented Implementation of CRM Designs

# emptydata <- Data(doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ################################################################################
# testdata0_1_5 <- Data(x=c(1.5, 1.5, 1.5),
#                   y=c(  0, 0, 0),
#                   cohort=c(1, 1, 1),
#                   doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata1_1_5  <- Data(x=c(1.5, 1.5, 1.5),
#                   y=c(  0, 0, 1),
#                   cohort=c(1, 1, 1),
#                   doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata2_1_5  <- Data(x=c(1.5, 1.5, 1.5),
#                   y=c(  0, 1, 1),
#                   cohort=c(1, 1, 1),
#                   doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata3_1_5  <- Data(x=c(1.5, 1.5, 1.5),
#                   y=c(1, 1, 1),
#                   cohort=c(1, 1, 1),
#                   doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ################################################################################
# testdata0_2_5 <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5),
#                       y=c(  0, 0, 0, 0, 0, 0),
#                       cohort=c( 1, 1, 1, 2, 2, 2 ),
#                       doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata1_2_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5),
#                        y=c( 0, 0, 0, 0, 0, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata2_2_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5),
#                        y=c( 0, 0, 0, 0, 1, 1),
#                        cohort=c( 1, 1, 1, 2, 2, 2),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata3_2_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5),
#                        y=c( 0, 0, 0, 1, 1, 1),
#                        cohort=c( 1, 1, 1, 2, 2, 2),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ################################################################################
# testdata0_3_5 <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5),
#                       y=c( 0, 0, 0, 0, 0, 0, 0, 0, 0),
#                       cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3),
#                       doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata1_3_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5),
#                        y=c( 0, 0, 0, 0, 0, 0, 0, 0, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata2_3_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5),
#                        y=c( 0, 0, 0, 0, 0, 0, 0, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata3_3_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5),
#                        y=c( 0, 0, 0, 0, 0, 0, 1, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ################################################################################
# testdata0_4_5 <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5),
#                       y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
#                       cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
#                       doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata1_4_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata2_4_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata3_4_5  <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ################################################################################
# testdata0_6_0 <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0),
#                       y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
#                       cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
#                       doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata1_6_0   <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata2_6_0   <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# 
# testdata3_6_0   <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0),
#                        y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1),
#                        cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
#                        doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ##############################################################################################################################
# testdata_DK   <- Data(x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0, 4.5, 4.5, 4.5, 6.0, 6.0, 6.0),
#                         y=c(  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0),
#                         cohort=c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7),
#                         doseGrid = c(1.5, 2.5, 3.5, 4.5, 6, 7 )
# )
# ############################################################################################################################
# # This dataset below is to test the different decision we see in the simulation comparison for scenario B_Late
# # After the 6.0 the proposal seems to be to deescalate in 1.5 in my simulation but in OB dataset (not shown here) 
# # the decision is to escalate in 7.0
# # when I rerun this dataset here individually it seems to give a recommendation of 4.5 after 6.0 and not 1.5 as in my simulation B outputs
# ################################################################################
# testdata_B_Late_84_full <- Data(
#   x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6, 6, 6, 1.5, 1.5, 1.5, 7.0, 7.0, 7.0),
#   y=c( 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1),
#   cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7 ),
#   doseGrid=c(1.5, 2.5, 3.5, 4.5, 6, 7),
#   ID=1:21
#   )



testdata_B_Late_84_d6.0 <- Data(
              # x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6, 6, 6, 1.5, 1.5, 1.5, 7.0, 7.0, 7.0),
              x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 6, 6, 6),
              # y=c( 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1),
              y=c( 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1),
              # cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7 ),
              cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
              doseGrid=c(1.5, 2.5, 3.5, 4.5, 6, 7),
              # ID=1:21,
              ID=1:15
              )
# ################################################################################
# # This dataset below is to test the different decision we see in the simulation comparison for scenario E_Peak
# # After the 3.5 the proposal seems to be to deescalate in 1.5 in my simulation but in OB dataset (not shown here)
# # the decision is to escalate in 4.5
# # when I rerun this dataset here individually it seems to give the correct proposal
# ################################################################################
# 
# testdata_E_Peak_87_full <- Data(
#   x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 3.5, 3.5, 3.5, 1.5, 1.5, 1.5, 4.5, 4.5, 4.5),
#   y=c(  0,   0,   0,   0,   0,   0,   0,   0,   0,   1,   1,   0,   0,   0,   0,   0,   0,   0,   1,   1,   1),
#   cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7  ),
#   doseGrid=c(1.5, 2.5, 3.5, 4.5, 6, 7),
#   ID=1:21,
#   )
# 
# testdata_E_Peak_87_d3.5 <- Data(
#   # x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 3.5, 3.5, 3.5, 1.5, 1.5, 1.5, 4.5, 4.5, 4.5),
#     x=c(1.5, 1.5, 1.5, 2.5, 2.5, 2.5, 3.5, 3.5, 3.5, 4.5, 4.5, 4.5, 3.5, 3.5, 3.5),
#   # y=c( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1),
#     y=c( 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0),
#   # cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6, 7, 7, 7 ),
#     cohort=c( 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
#     doseGrid=c(1.5, 2.5, 3.5, 4.5, 6, 7),
#   # ID=1:21,
#     ID=1:15
#     )
# ###############################################################################################################
# ###############################################################################################################
## 1. model set-up
MSLN_TTC_Model <- LogisticKadane2(theta = 0.3, 
                                  dmin = 1.5, 
                                  dmax = 7, 
                                  alpha = 1, 
                                  beta = 19, 
                                  shape = 0.5625, 
                                  rate = 0.125)


## 2. escalation rules set-up
## 2.1. nextBest rule set-up
NextBestDose_Rule <- NextBestMTDCRM(target=0.3,pbomethod="max")

## 2.2. increments rules set-up 
## 2.2.1 no dose skipping 
Increment_Rule1 <-IncrementsNumDoseLevelsMaxTested(maxLevels = 1)

## 2.2.2 hard safety rule
Increment_Rule2<- IncrementsHSRBeta(target=0.3,prob=0.95,a=1,b=1)

## combine all the increments rules
Increment_Rules_Combined <- IncrementMin(IncrementsList=list(Increment_Rule1,Increment_Rule2))

## 2.3. stopping rules set-up
## 2.3.1 Minimum dose tested (1.5MBq) is toxic: Hard safety rule based on Beta distribution
# StoppingMinDoseToxicHSR <-
#   StoppingLowestDose() &
#   StoppingDoseHSRBeta(target=0.3,
#                       prob=0.95,
#                       a=1,
#                       b=1) 
# 
# Stopping_Rule1 <- StoppingMinDoseToxicHSR

Stopping_Rule1 <- StoppingLowestDoseHSRBeta(target=0.3,
                                            prob=0.95,
                                            a=1,
                                            b=1) 

## 2.3.2 Minimum dose tested (1.5MBq) is toxic: T1 < 20%
# StoppingMinDoseToxic <-
#   StoppingLowestDose() &
#   StoppingPatientsNearDose(nPatients=3, percentage=0) &
#   StoppingTargetProb(target=c(0.3, 1), prob=0.8)

# Stopping_Rule2 <- StoppingMinDoseToxic

Stopping_Rule2 <- StoppingTargetProbPatientsNearLowestDose(target=c(0.3, 1), prob=0.8,nPatients=3, percentage=0)

## 2.3.3	Maximum possible dose (7.0MBq) is safe: TN > 80% and 7.0MBq administered.
# StoppingMaxDoseSafe <-
#   StoppingHighestDose() &
#   StoppingPatientsNearDose(nPatients=3,percentage=0) &
#   StoppingTargetProb(target=c(0, 0.3),prob=0.8)
# 
# Stopping_Rule3 <- StoppingMaxDoseSafe

Stopping_Rule3 <- StoppingTargetProbPatientsNearHighestDose(target=c(0, 0.3), prob=0.8,nPatients=3, percentage=0)

## 2.3.4 MTD precisely estimated: CV(MTD)<= 30%.
Stopping_Rule4 <- StoppingMTDCV(target = 0.30, thresh = 0.3)

## 2.3.5 Total sample size for next dose is already >= 9.
Stopping_Rule5 <- StoppingPatientsNearDose(nPatients = 9,percentage = 0)

## combine all the stopping rules  
Stopping_Rules_Combined <- (Stopping_Rule1 | Stopping_Rule2 | Stopping_Rule3  | Stopping_Rule4  | Stopping_Rule5)

## 2.3. cohortSize rules set-up
## 2.3.1 constant cohort size of 3 along the study
CohortSize_Rule1<-CohortSizeConst(3)

# combine all the cohortSize rules
CohortSize_Rules_Combined <- maxSize(CohortSize_Rule1)

################################################################################
# data<-testdata_E_Peak_87_d3.5

 data<-testdata_B_Late_84_d6.0

#plot(data)

model<-MSLN_TTC_Model
###############################################################################
## define simulation design   
# MSLN_TTC_Design <- Design(model=MSLN_TTC_Model,
#                           nextBest=NextBestDose_Rule,
#                           stopping=Stopping_Rules_Combined,
#                           increments=Increment_Rules_Combined,
#                           cohortSize=CohortSize_Rules_Combined,
#                           data=emptydata,
#                           startingDose=1.5)
## define simulation seed
options <- McmcOptions(burnin = 1000, step = 1, samples = 10000)
# set.seed(94)
# set.seed(44135)
set.seed(6018)

samples <- mcmc(data, model, options)

nextMaxDose <- maxDose(Increment_Rules_Combined,
                       data=data)

nextMaxDose1 <- maxDose(Increment_Rule1,
                       data=data)

nextMaxDose2 <- maxDose(Increment_Rule2,
                        data=data)

doseRecommendation <- nextBest(NextBestDose_Rule,
                                    doselimit=nextMaxDose,
                                    samples=samples, 
                                    model=model,
                                    data=data)
nextMaxDose
nextMaxDose1
nextMaxDose2
doseRecommendation$value
print(doseRecommendation$plot)

# stop_test<- stopTrial(stopping=Stopping_Rules_Combined, dose=doseRecommendation$value,samples=samples, model=model, data=data)
# 
# stop_test1<- stopTrial(stopping=MSLN_TTC_Design@stopping@stopList[[1]], dose=doseRecommendation$value,samples=samples, model=model, data=data)
# stop_test2<- stopTrial(stopping=MSLN_TTC_Design@stopping@stopList[[2]], dose=doseRecommendation$value,samples=samples, model=model, data=data)
# stop_test3<- stopTrial(stopping=MSLN_TTC_Design@stopping@stopList[[3]], dose=doseRecommendation$value,samples=samples, model=model, data=data)
# stop_test4<- stopTrial(stopping=MSLN_TTC_Design@stopping@stopList[[4]], dose=doseRecommendation$value,samples=samples, model=model, data=data)
# stop_test5<- stopTrial(stopping=MSLN_TTC_Design@stopping@stopList[[5]], dose=doseRecommendation$value,samples=samples, model=model, data=data)
#